﻿{ ******************************************************* }
{ }
{ DelphiWebMVC 5.0 }
{ E-Mail:pearroom@yeah.net }
{ 版权所有 (C) 2022-2 苏兴迎(PRSoft) }
{ }
{ ******************************************************* }
unit MVC.DB;

interface

uses
  System.SysUtils, System.Classes, System.Generics.Collections, Web.HTTPApp,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error,
  FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async,
  FireDAC.Phys.FBDef, FireDAC.Phys.FB, FireDAC.DApt, Data.DB, Datasnap.DBClient,
  FireDAC.Comp.Client, MVC.Config, MVC.LogUnit, MVC.DM, MVC.JSON, System.JSON,
  FireDAC.Comp.DataSet, MVC.Tool, MVC.DSQuery, MVC.DataSet, DateUtils, MVC.DES;

type
  TDBConns = class
  private
    ConnList: Tlist<TFDConnection>;
  public
    function findDb(DbName: string): TFDConnection; // 找对应名称的数据库链接
    constructor Create();
    destructor Destroy; override;
  end;

  TDBItem = class
  private
    DbConns: TDBConns;

    FDbState: Integer;
    FID: string;
    TMP_CDS: TDSQuery;
    FOverTime: TDateTime;
    FDriverName: string;
    procedure SetDbState(const Value: Integer);
    procedure SetID(const Value: string);
    procedure SetOverTime(const Value: TDateTime);
    function PageMySql(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageSqlite(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PagePostgreSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageMSSQL08(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageMSSQL12(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageMSSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageFireBird(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    function PageOracle(sql: ISQL; pNumber, pSize: Integer): IDataSet;
    procedure SetDriverName(const Value: string);
  protected
    function GetFirstConn: TFDConnection;
  public

    Conn: TFDConnection;
    property DbState: Integer read FDbState write SetDbState;
    property ID: string read FID write SetID;
    property OverTime: TDateTime read FOverTime write SetOverTime;
    property DriverName: string read FDriverName write SetDriverName;
    function TryConn: boolean; // 尝试进行数据库链接
    procedure StartTransaction(); // 启动事务
    function InTransaction: Boolean;
    procedure Commit; // 事务提交
    procedure Rollback; // 事务回滚

    function GetMSSQLVer: string; // 获取mssql 服务器版本 根据版本号使用不同的分页算法
    procedure SetConn(DbName: string); // 设置使用数据库
    function Query(sql: string): IDataSet; overload;
    function Query<T>(sql: string): IDataSet<T>; overload;
    function Query(sql: string; cds: TFDQuery): boolean; overload;
    function QueryToCDS(SQL: string; cds: TClientDataSet): Boolean;

    function ExecSQL(sql: string): Integer; overload;
    function ExecSQL(sqltpl: ISQLTpl): Integer; overload;
    function ExecSQL(cds: TDSQuery): boolean; overload;
    function ExecSQL(cds: TFDQuery): boolean; overload;



    function Find(sql: ISQL): IDataSet; overload;
    function Find(sql: string): IDataSet; overload;
    function Find(sqltpl: ISQLTpl): IDataSet; overload;
    function Find(sqltpl: ISQLTpl; pNumber: Integer; pSize: Integer): IDataSet; overload;
    function Find(sql: ISQL; pNumber: Integer; pSize: Integer): IDataSet; overload; // 分页查询
    function Find(tablename: string; map: IJObject): IDataSet; overload;
    function FindByKey(tablename: string; key: string; Value: string): IDataSet;
    function Add(tablename: string): TDSQuery;
    function Edit(tablename: string; key: string; Value: string): TDSQuery;
    function DelByKey(tablename: string; key: string; Value: string): boolean;
    function filterSQL(sql: string): string;
    function isEmpty(tableName: string; FieldKey, FieldName, FieldDisplay: string; map: IJObject; var res: TResData): boolean;
    //
    constructor Create(isConn: boolean = True);
    destructor Destroy; override;
  end;

  TDBPool = class
  private
    isClose: boolean;
  public
    procedure setParams;
    function getDbItem: TDBItem;
    procedure freeDbItem(dbitem: TDBItem);
    constructor Create;
    destructor Destroy; override;
  end;

  TDBI = class(TDBItem)
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TDB = class(TDBItem) // 创建时不新建连接
  private
    defdbitem: TDBItem;
    sdb: TDBI;
  public
    function use(DbName: string): TDBI;
    constructor Create;
    destructor Destroy; override;
  end;

  TFieldT = TFieldType;

  TParamT = TParamType;

  IConn = interface
    ['{9837B6A3-176C-4247-8BB7-D566D76A4297}']
    function DB: TDB;
  end;

  TConn = class(TInterfacedObject, IConn)
  private
    FDb: TDB;
  public
    function DB: TDB;
    constructor Create;
    destructor Destroy; override;
  end;

var
  DBPool: TDBPool;

function IIConn: IConn; // 获取一个新的链接

procedure InitDB;//创建链接池

implementation

function IIConn: IConn;
begin
  Result := TConn.Create as IConn;
end;

procedure InitDB;
begin
  if not Assigned(DBPool) then
    DBPool := TDBPool.Create;
end;
{ TDBItem }

function TDBItem.Add(tablename: string): TDSQuery;
var
  sql: string;
begin
  Result := nil;
  if not TryConn then
    Exit;
  if (Trim(tablename) = '') then
    Exit;
  try
    sql := filterSQL(sql);
    sql := 'select * from ' + tablename + ' where 1=2';
    TMP_CDS.Connection := Conn;
    TMP_CDS.sql.Text := sql;
    TMP_CDS.Open;
    TMP_CDS.Append;
    Result := TMP_CDS;
  except
    on e: Exception do
    begin
      Result := nil;
      log(e.ToString);
    end;
  end;
end;

procedure TDBItem.Commit;
begin

  DbState := 0;
  if not TryConn then
    Exit;
  Conn.Commit;
end;

constructor TDBItem.Create(isConn: boolean);
begin

  if isConn then
  begin
    DbConns := TDBConns.Create;
    begin
      Conn := DbConns.ConnList[0];
      DriverName := Conn.DriverName;
    end;
  end;

  DbState := 1;
end;

function TDBItem.DelByKey(tablename, key, Value: string): boolean;
var
  sql: string;
begin
  Result := False;
  if not TryConn then
    Exit;
  if (Trim(tablename) = '') then
    Exit;
  if (Trim(key) = '') then
    Exit;
  if (Trim(Value) = '') then
    Exit;
  sql := 'delete from ' + tablename + ' where ' + key + '=' + QuotedStr(Value);
  Result := ExecSQL(sql) > 0;
end;

destructor TDBItem.Destroy;
begin
  if Assigned(TMP_CDS) then
  begin
    TMP_CDS.Close;
    FreeAndNil(TMP_CDS);
  end;
  if Assigned(DbConns) then
  begin
    FreeAndNil(DbConns);
  end;

  inherited;
end;

function TDBItem.filterSQL(sql: string): string;
begin
  if Config.show_sql then
    log(sql);
  // Result := sql.Replace(';', '').Replace('-', '');
  Result := sql;
end;

function TDBItem.Edit(tablename, key, Value: string): TDSQuery;
var
  sql: string;
begin
  Result := nil;
  if not TryConn then
    Exit;
  if (Trim(tablename) = '') then
    Exit;
  if (Trim(key) = '') then
    Exit;
  try
    sql := 'select * from ' + tablename + ' where ' + key + ' = ' + Value;
    sql := filterSQL(sql);
    TMP_CDS.Connection := Conn;
    TMP_CDS.Open(sql);
    if (not TMP_CDS.IsEmpty) then
    begin
      TMP_CDS.First;
      TMP_CDS.Edit;
      Result := TMP_CDS;
    end
    else
      Result := nil;
  except
    Result := nil;
  end;
end;

function TDBItem.ExecSQL(cds: TFDQuery): boolean;
begin
  Result := False;
  if not TryConn then
    Exit;
  try
    cds.Connection := Conn;
    Result := cds.OpenOrExecute;
  except
    on e: Exception do
    begin
      log('SQL执行异常:' + e.Message);
      Result := False;
    end;
  end;
end;

function TDBItem.ExecSQL(cds: TDSQuery): boolean;
begin
  Result := False;
  if not TryConn then
    Exit;
  try
    cds.Connection := Conn;
    Result := cds.OpenOrExecute;
  except
    on e: Exception do
    begin
      log('SQL执行异常:' + e.Message);
      Result := False;
    end;
  end;
end;

function TDBItem.ExecSQL(sqltpl: ISQLTpl): Integer;
var
  sql: string;
begin
  sql := sqltpl.AsISQL.sql.Text;
  Result := ExecSQL(sql);
end;

function TDBItem.ExecSQL(sql: string): Integer;
var
  cds: TFDQuery;
begin
  Result := -1;
  if not TryConn then
    Exit;
  if (Trim(sql) = '') then
    Exit;
  cds := TFDQuery.Create(nil);
  Lock(Conn);
  try
    try
      cds.FetchOptions.Mode := fmAll;
      sql := filterSQL(sql);
      cds.Connection := Conn;
      Result := cds.ExecSQL(sql);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sql);
        Result := -1;
      end;
    end;
  finally
    cds.Free;
    UnLock(conn);
  end;
end;

function TDBItem.Find(sql: ISQL): IDataSet;
var
  s: string;
begin
  Result := nil;
  s := filterSQL(sql.Text);
  Result := Query(s);
end;

function TDBItem.QueryToCDS(SQL: string; cds: TClientDataSet): Boolean;
var
  ds: TFDQuery;
  i: Integer;
begin
  Result := False;
  if Trim(SQL) = '' then
  begin
    DbState := 0;
    Exit;
  end;
  if TryConn then
  begin
    ds := TFDQuery.Create(nil);
    try
      try
        ds.FetchOptions.Mode := fmAll;
        SQL := filterSQL(SQL).Trim;
        ds.Connection := Conn;
        ds.Close;
        ds.SQL.Text := SQL;
        ds.Open;
        cds.Close;
        cds.FieldDefs.Clear;
        cds.Fields.Clear;
        for i := 0 to ds.Fields.Count - 1 do
        begin
          if ds.Fields[i].DataType = ftAutoInc then
            cds.FieldDefs.Add(ds.Fields[i].FieldName, ftInteger, ds.Fields[i].Size)
          else
            cds.FieldDefs.Add(ds.Fields[i].FieldName, ds.Fields[i].DataType, ds.Fields[i].Size);
        end;
        cds.CreateDataSet;
        ds.First;
        while not ds.Eof do
        begin
          cds.Append;
          for i := 0 to cds.FieldDefs.Count - 1 do
          begin
            cds.FieldByName(cds.Fields[i].FieldName).Value := ds.FieldByName(cds.Fields[i].FieldName).Value;
          end;
          cds.Post;
          ds.Next;
        end;
        Result := True;
      except
        on e: Exception do
        begin
          log('SQL执行异常:' + e.Message + '-' + SQL);
          Result := False;
        end;
      end;
    finally
      ds.Free;
    end;
  end
  else
  begin
    log('数据库链接失败：' + self.Conn.ConnectionDefName);
    Result := False;
    DbState := 0;
  end;
end;

function TDBItem.Find(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  device, mssqlver, ver: string;
begin
  device := Conn.DriverName;
  if device.ToLower = 'mysql' then
  begin
    Result := PageMySql(sql, pNumber, pSize);
  end
  else if device.ToLower = 'fb' then
  begin
    Result := PageFireBird(sql, pNumber, pSize);
  end
  else if device.ToLower = 'sqlite' then
  begin
    Result := PageSqlite(sql, pNumber, pSize);
  end
  else if device.ToLower = 'pg' then
  begin
    Result := PagePostgreSQL(sql, pNumber, pSize);
  end
  else if device.ToLower = 'ora' then
  begin
    Result := PageOracle(sql, pNumber, pSize);
  end
  else if device.ToLower = 'mssql' then
  begin
    // 如果是mssql 数据库 判断当前所使用版本来使用
    { SELECT SERVERPROPERTY('ProductVersion') AS 实例版本 }
    mssqlver := GetMSSQLVer;
    ver := mssqlver.Split(['.'])[0];
    if (ver.ToInteger = 10) or (ver.ToInteger = 9) then // 版本是10 是 mssql2008 版本是9 是 mssql2005
    begin
      Result := PageMSSQL08(sql, pNumber, pSize);
    end
    else if ver.ToInteger > 10 then // 大于 10，11：mssql2012;12 mssql2014;13 mssql2016;14mssql2017;
    begin
      Result := PageMSSQL12(sql, pNumber, pSize);
    end
    else if ver.ToInteger = 8 then // 2000版本
    begin
      Result := PageMSSQL(sql, pNumber, pSize);
    end;
  end
  else
    Result := nil;
end;

function TDBItem.Find(sqltpl: ISQLTpl; pNumber, pSize: Integer): IDataSet;
begin
  Result := Find(sqltpl.AsISQL, pNumber, pSize);
end;

function TDBItem.Find(sqltpl: ISQLTpl): IDataSet;
var
  sql: string;
  i_sql: ISQL;
begin
  i_sql := sqltpl.AsISQL;
  if i_sql <> nil then
  begin
    sql := i_sql.sql.Text;
    Result := Query(sql);
  end
  else
  begin
    log('没有获取SQL脚本');
  end;
end;

function TDBItem.Find(sql: string): IDataSet;
begin

  Result := Query(sql);
end;

function TDBItem.Find(tablename: string; map: IJObject): IDataSet;
var
  i: Integer;
  item: TJSONPair;
  key, Value: string;
  sql: ISQL;
  cds: IDataSet;
begin
  cds := Find('select * from ' + tablename + ' where 1<>1 ');
  if cds <> nil then
  begin
    sql := IISQL(tablename);
    for i := 0 to map.O.Count - 1 do
    begin
      item := map.O.Pairs[i];
      key := item.JsonString.Value;
      Value := item.JsonValue.Value;
      if cds.DS.Fields.FindField(key) <> nil then
        sql.AndEqF(key, Value);
    end;
    Result := Find(sql);
  end
  else
  begin
    Result := nil;
  end;
end;



function TDBItem.FindByKey(tablename, key, Value: string): IDataSet;
var
  sql: ISQL;
begin

  try
    if not TryConn then
      Exit;
    if (Trim(tablename) = '') then
      Exit;
    if (Trim(key) = '') then
      Exit;
    if (Trim(Value) = '') then
      Exit;
    sql := IISQL(tablename);
    sql.AndEqF(key, Value);
    Result := Find(sql);
  except
    on e: Exception do
    begin
      log(e.Message);
      Result := nil;
    end;
  end;
end;

function TDBItem.GetFirstConn: TFDConnection;
begin
  if DbConns.ConnList.Count > 0 then
    Result := DbConns.ConnList[0]
  else
    Result := nil;
end;

function TDBItem.GetMSSQLVer: string;
var
  DS: IDataSet;
begin
  DS := Query('SELECT SERVERPROPERTY(''ProductVersion'') AS ver');
  Result := DS.DS.FieldByName('ver').AsString;
end;

function TDBItem.InTransaction: Boolean;
begin
  Result := false;
  if not TryConn then
    Exit;
  Result := Conn.InTransaction;
end;

function TDBItem.isEmpty(tableName: string; FieldKey, FieldName, FieldDisplay: string; map: IJObject; var res: TResData): boolean;
var
  ds: IDataSet;
  id: string;
  sql: Isql;
  db: IConn;
begin

  db := IIConn;
  sql := IISQL(tableName);
  id := map.S[FieldKey];
  sql.AndEqF(FieldName, map.S[FieldName]);
  if id.Trim <> '' then
    sql.AndNeF(FieldKey, id);

  ds := db.DB.Find(sql);
  if not ds.isEmpty then
  begin
    res.code := -1;
    res.message := FieldDisplay + '已存在';
    Result := false;
  end
  else
  begin
    res.code := 0;
    res.message := '成功';
    Result := true;
  end;
end;

function TDBItem.PageFireBird(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order, sel: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  order := sql.getOrder;
  try
    try
      if sql.getSelect.Trim = '' then
        sel := '*'
      else
        sel := sql.getSelect.Replace('select', '');
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);

      sq := 'select FIRST ' + inttostr(pSize) + ' SKIP '
        + inttostr(pNumber * pSize) + ' '
        + sel + ' ' + sql.getFrom + ' ' + Trim(order);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMSSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order: string;
  Count: Integer;
  tmp: string;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;

  order := sql.getOrder;
  try
    try
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      if Pos('where', sql.getFrom) > 0 then
        tmp := ' and '
      else
        tmp := ' where ';
      sq := ' select top ' + inttostr(pSize) + ' '
        + sql.getSelect.Replace('select', '')
        + sql.getFrom;

      if pNumber > -1 then
      begin
        sq := sq + tmp + ' id not in(select top '
          + inttostr(pSize * pNumber) + ' id '
          + sql.getFrom + ' ' + order + ') ';
      end;
      sq := sq + order;
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PagePostgreSQL(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  DataSet := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  try
    try
      sq := 'select count(1) as N' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);

      sq := sql.getSelect + ' ' + sql.getFrom + ' ' + sql.getOrder
        + ' limit ' + inttostr(pNumber * pSize) + ',' + inttostr(pSize);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMSSQL08(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;

  order := sql.getOrder;

  try
    try

      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);

      sq := ' select *,ROW_NUMBER() OVER(' + order + ') AS RowNo from ('
        + sql.getSelect + ',0 row ' + sql.getFrom + ') tmp1 ';

      sq := ' select * from (' + sq + ') tmp2 where RowNo between '
        + inttostr(pNumber * pSize + 1) + ' and '
        + inttostr(pNumber * pSize + pSize);

      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMSSQL12(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq, order: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  order := sql.getOrder;
  try
    try
      if Trim(order) = '' then
        order := ' order by 1 ';
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := sql.getSelect + ' ' + sql.getFrom + ' ' + Trim(order)
        + ' offset ' + inttostr(pNumber * pSize)
        + ' rows fetch next ' + inttostr(pSize) + ' rows only ';
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageMySql(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  DataSet := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  try
    try
      sq := 'select count(1) as N' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := sql.getSelect + sql.getFrom + ' ' + sql.getOrder
        + ' limit ' + inttostr(pNumber * pSize) + ',' + inttostr(pSize);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageOracle(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  Result := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;
  try
    try
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := 'select A.*,to_number(rownum) rn from('
        + sql.getSelect + sql.getFrom + ' ' + sql.getOrder + ') A ';
      sq := 'select * from (' + sq + ') where rn > ' + inttostr(pSize * pNumber)
        + ' and rn <=' + inttostr(pSize * pNumber + pSize);

      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.PageSqlite(sql: ISQL; pNumber, pSize: Integer): IDataSet;
var
  sq: string;
  Count: Integer;
  DataSet: IDataSet;
begin
  DataSet := nil;
  if (not TryConn) or (Trim(sql.getSelect) = '') or (Trim(sql.getFrom) = '')
    then
    Exit;

  try
    try
      sq := 'select count(1) as N ' + sql.getFrom;
      sq := filterSQL(sq);
      Count := Conn.ExecSQLScalar(sq);
      sq := sql.getSelect + sql.getFrom + ' ' + sql.getOrder
        + ' limit ' + inttostr(pNumber * pSize) + ',' + inttostr(pSize);
      DataSet := Query(sq);
      DataSet.setCount(Count);
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sq);
        DataSet := nil;
      end;
    end;
  finally
    Result := DataSet;
  end;
end;

function TDBItem.Query(sql: string): IDataSet;
var
  cds: IDataSet;
  ds: TFDQuery;
begin
  Result := nil;
  if Trim(sql) = '' then
  begin
    DbState := 0;
    Exit;
  end;

  if TryConn then
  begin
    Lock(Conn);
    Result := nil;
    ds := TFDQuery.Create(nil);
    try
      try
        ds.FetchOptions.Mode := fmAll;
        sql := filterSQL(sql).Trim;
        ds.Connection := Conn;
        ds.Close;
        ds.SQL.Text := sql;
        ds.Open;
        cds := IIDataSet;
        cds.DS.AppendData(ds);
        Result := cds;
      except
        on e: Exception do
        begin
          log('SQL执行异常:' + e.Message + '-' + sql);
          Result := nil;
        end;
      end;
    finally
      ds.Free;
      UnLock(Conn);
    end;
  end
  else
  begin
    log('数据库链接失败：' + self.Conn.ConnectionDefName);
    Result := nil;
    DbState := 0;
  end;
end;

procedure TDBItem.Rollback;
begin
  DbState := 0;
  if not TryConn then
    Exit;
  Conn.Rollback;
end;

procedure TDBItem.SetConn(DbName: string);
begin

  Self.Conn := DbConns.findDb(DbName);
  Self.DriverName := Self.Conn.DriverName;
end;

procedure TDBItem.SetDbState(const Value: Integer);
begin
  FDbState := Value;
end;

procedure TDBItem.SetDriverName(const Value: string);
begin
  FDriverName := Value;
end;

procedure TDBItem.SetID(const Value: string);
begin
  FID := Value;
end;

procedure TDBItem.SetOverTime(const Value: TDateTime);
begin
  FOverTime := Value;
end;

procedure TDBItem.StartTransaction;
begin
  if not TryConn then
    Exit;
  Conn.StartTransaction;
end;

function TDBItem.TryConn: boolean;
begin
  if Conn = nil then
  begin
    Result := False;
    Exit;
  end;
  try
    Conn.CheckActive;
    conn.ExecSQLScalar('select 1');
  except
    try
      conn.Close;
      conn.Open;
      Conn.Connected := true;
    except
      on e: Exception do
      begin
        log(e.Message);
      end;
    end;
  end;
  if Conn.Connected then
  begin
    if TMP_CDS = nil then
    begin
      TMP_CDS := TDSQuery.Create(nil);
      TMP_CDS.FetchOptions.Mode := fmAll;
      TMP_CDS.Connection := Conn;
    end;
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end;

function TDBItem.Query(sql: string; cds: TFDQuery): boolean;
begin
  Result := false;
  if not TryConn then
    Exit;
  if (Trim(sql) = '') then
    Exit;
  Lock(Conn);
  try
    try
      sql := filterSQL(sql);
      cds.Connection := Conn;
      cds.Open(sql);
      Result := true;
    except
      on e: Exception do
      begin
        log('SQL执行异常:' + e.Message + '-' + sql);
        Result := True;
      end;
    end;
  finally
    UnLock(conn);
  end;
end;


function TDBItem.Query<T>(sql: string): IDataSet<T>;
var
  cds: IDataSet<T>;
  ds: TFDQuery;
begin
  Result := nil;
  if Trim(sql) = '' then
  begin
    DbState := 0;
    Exit;
  end;

  if TryConn then
  begin
    Lock(Conn);
    Result := nil;
    ds := TFDQuery.Create(nil);
    try
      try
        ds.FetchOptions.Mode := fmAll;
        sql := filterSQL(sql).Trim;
        ds.Connection := Conn;
        ds.Close;
        ds.SQL.Text := sql;
        ds.Open;
        cds := TDataSet<T>.Create() as IDataSet<T>;
        cds.DS.AppendData(ds);
        Result := cds;
      except
        on e: Exception do
        begin
          log('SQL执行异常:' + e.Message + '-' + sql);
          Result := nil;
        end;
      end;
    finally
      ds.Free;
      UnLock(Conn);
    end;
  end
  else
  begin
    log('数据库链接失败：' + self.Conn.ConnectionDefName);
    Result := nil;
    DbState := 0;
  end;
end;

{ TDB }

constructor TDB.Create;
begin
  inherited Create(False);
  if DBPool = nil then
    InitDB;
  defdbitem := DBPool.getDbItem;
  self.Conn := defdbitem.GetFirstConn;
  DriverName := Conn.DriverName;
end;

destructor TDB.Destroy;
begin
  // 释放链接到连接池
  DBPool.freeDbItem(defdbitem);
  if Assigned(sdb) then
    FreeAndNil(sdb);
  inherited;
end;

function TDB.use(DbName: string): TDBI;
begin
  if not Assigned(sdb) then
    sdb := TDBI.Create;
  defdbitem.SetConn(DbName);
  sdb.Conn := defdbitem.Conn;
  Result := sdb;
end;

{ TDBConns }

constructor TDBConns.Create();
var
  dbconfig: IJObject;
  DbType: string;
  i: Integer;
  DB: TFDConnection;
begin
  ConnList := Tlist<TFDConnection>.Create();
  dbconfig := IIJObject(Config.dbconfig);
  for i := 0 to dbconfig.O.Count - 1 do
  begin
    DbType := dbconfig.O.Pairs[i].JsonString.Value;
    DB := TFDConnection.Create(nil);
    DB.ResourceOptions.AutoReconnect := True;
    DB.FetchOptions.RowsetSize := 10000;
    DB.ConnectionDefName := DbType;
    ConnList.Add(DB);
  end;
end;

destructor TDBConns.Destroy;
var
  i: Integer;
  conn: TFDConnection;
begin
  for i := 0 to ConnList.Count - 1 do
  begin
    conn := ConnList[i];
    if conn.Connected then
      conn.Connected := False;
    FreeAndNil(conn);
  end;
  ConnList.Clear;
  FreeAndNil(ConnList);
  inherited;
end;

function TDBConns.findDb(DbName: string): TFDConnection;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to ConnList.Count - 1 do
  begin
    if ConnList[i].ConnectionDefName = DbName then
    begin
      Result := ConnList[i];
      break;
    end;
  end;

  if Result = nil then
  begin
    log(DbName + '数据库名称未配置');
  end;
end;

{ TDBPool }

constructor TDBPool.Create;
begin
  isClose := False;
  setParams;
end;

destructor TDBPool.Destroy;
begin
  isClose := True;
  inherited;
end;

procedure TDBPool.freeDbItem(dbitem: TDBItem);
begin
  FreeAndNil(dbitem);
end;

function TDBPool.getDbItem: TDBItem;
var
  item: TDBItem;
begin
  item := TDBItem.Create();
  item.ID := GetGUID;
  Result := item;
end;

procedure TDBPool.setParams;
var
  dbconfig: IJObject;
  connjo: TJSONObject;
  i: Integer;
  key, Value: string;
  oParams: TStringList;
  j: Integer;
  connkey, connValue: string;
  driverID, Database: string;
begin
  with MVCDM do
  begin
    DBManager.Active := False;
    dbconfig := IIJObject(Config.dbconfig);
    for i := 0 to dbconfig.O.Count - 1 do
    begin
      oParams := TStringList.Create;
      key := dbconfig.O.Pairs[i].JsonString.Value;
      connjo := dbconfig.O.Pairs[i].JsonValue as TJSONObject;
      Database := '';
      driverID := '';
      for j := 0 to connjo.Count - 1 do
      begin
        connkey := Trim(connjo.Pairs[j].JsonString.Value);
        connValue := Trim(connjo.Pairs[j].JsonValue.Value);
        if LowerCase(connkey) = 'password' then
        begin
          if Trim(config.password_key) <> '' then
          begin
            connValue := string(DeCryptStr(AnsiString(connValue), AnsiString(config.password_key)));
          end;
        end;
        Value := connkey + '=' + connValue;
        oParams.Add(Value);
        if connkey = 'DriverID' then
          driverID := connValue;
        if connkey = 'Database' then
          Database := connValue;
        if (driverID = 'SQLite') and (Database <> '') then
        begin
          {$IFDEF SERVICE}
          Database := Config.BasePath + oParams.Values['Database'];
          {$ELSE}
          Database := oParams.Values['Database'];
          {$ENDIF}
          Database := IITool.PathFmt(Database);
          LogDebug(Database);
          oParams.Values['Database'] := Database;
          Database := '';
        end;
      end;
      DBManager.AddConnectionDef(key, driverID, oParams);
      oParams.Free;
    end;
    DBManager.Active := True;
  end;
end;

{ TConn }

constructor TConn.Create;
begin
  FDb := TDB.Create;
end;

function TConn.db: TDB;
begin
  Result := FDb;
end;

destructor TConn.Destroy;
begin
  FDb.Free;
  inherited;
end;

{ TDBI }

constructor TDBI.Create;
begin
  inherited Create(False);
end;

destructor TDBI.Destroy;
begin

  inherited;
end;

initialization

finalization
  if Assigned(DBPool) then
    DBPool.Free;

end.

